home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / scsh / oldhere.scm < prev    next >
Text File  |  1995-10-13  |  4KB  |  101 lines
  1. ;;; Here documents in Scheme for scsh scripts.
  2. ;;; These are like "here documents" for sh and csh shell scripts
  3. ;;; (i.e., the <<EOF redirection).
  4. ;;; Copyright (c) 1995 by Olin Shivers.
  5.  
  6. ;;; #<EOF
  7. ;;; Hello, there.
  8. ;;; This is read by Scheme as a string,
  9. ;;; terminated by the first occurrence
  10. ;;; of newline-E-O-F.
  11. ;;; EOF
  12.  
  13. ;;; Thus, 
  14. ;;;     #<foo
  15. ;;;     Hello, world.
  16. ;;;     foo
  17. ;;; is the same thing as
  18. ;;;     "Hello, world."
  19.  
  20. ;;; These are useful for writing down long, constant strings -- such
  21. ;;; as long, multi-line FORMAT strings, or arguments to Unix programs, e.g.
  22. ;;;     ;; Free up some disk space for my netnews files.
  23. ;;;     (run (csh -c #<EOF
  24. ;;;     cd ~bdc
  25. ;;;     rm -rf .
  26. ;;;     echo All done.
  27. ;;;    
  28. ;;;     EOF))
  29.  
  30. ;;; The syntax is as follows: the three characters "#<" introduce the
  31. ;;; here-string. The characters between the second "<" and the next newline
  32. ;;; are the *delimiter word." *All* chars between the second "<" and the next
  33. ;;; newline comprise the delimiter word -- including any white space. The
  34. ;;; newline char separates the delimiter word from the body of the string. The
  35. ;;; string body is terminated by a newline followed by the delimiter string.
  36. ;;; Absolutely *no* interpretation is done on the input string, except for
  37. ;;; scanning for the terminating delimiter word. Control chars, white space,
  38. ;;; quotes, backslash chars -- everything is copied as-is.
  39. ;;; 
  40. ;;; If EOF is encountered before reading the end of the here string, an
  41. ;;; error is signalled.
  42.  
  43. (define (read-here-string port)
  44.   ;; First, read in the delimiter.
  45.   (let ((delim (read-line port)))
  46.     (cond ((eof-object? delim)
  47.        (reading-error port "EOF while reading #< here-string delimiter."))
  48.       ((zero? (string-length delim))
  49.        (reading-error port "#< here-string empty delimiter"))
  50.  
  51.       ;; This loop works as follows. We enter the loop after having
  52.       ;; read a newline. We scan into the text until we discover
  53.       ;; delimiter match/no-match. If match, we exit the loop;
  54.       ;; if no match, we read in the rest of the line and iterate. 
  55.       ;; TEXT is the text we've read so far -- a list of strings in 
  56.       ;; reverse order.
  57.       (else
  58.        (let lp ((text '()))
  59.          (cond ((delimiter-scan delim port) =>
  60.             (lambda (line-start)
  61.               (let ((text (cons line-start text))
  62.                 (ls-len (string-length line-start)))
  63.             (lp (if (char=? #\newline (string-ref line-start
  64.                                   (- ls-len 1)))
  65.                 text
  66.                 (let ((line-rest (read-line port 'concat)))
  67.                   (if (eof-object? line-rest)
  68.                       (reading-error port
  69.                        "EOF while reading #< here-string.")
  70.                       (cons line-rest text))))))))
  71.  
  72.            ;; We're done. The last line, tho, needs its newline
  73.            ;; stripped off.
  74.            ((null? text) "")
  75.            (else (let* ((last-chunk (car text))
  76.                 (lc-len (string-length last-chunk))
  77.                 (last-chunk (substring last-chunk 0 (- lc-len 1)))
  78.                 (text (cons last-chunk (cdr text))))
  79.                (make-immutable! (apply string-append
  80.                            (reverse text)))))))))))
  81.  
  82.  
  83. ;;; If the next chars read from PORT match DELIM, return false.
  84. ;;; Otherwise, return the string you read from PORT to determine the non-match.
  85. ;;; If EOF is encountered, report an error.
  86.  
  87. (define (delimiter-scan delim port)
  88.   (let ((len (string-length delim)))
  89.     (let lp ((i 0))
  90.       (and (< i len)
  91.        (let ((c (read-char port)))
  92.          (cond  ((eof-object? c)
  93.              (reading-error port "EOF while reading #< here string."))
  94.             ((char=? c (string-ref delim i))
  95.              (lp (+ i 1)))
  96.             (else (string-append (substring delim 0 i)
  97.                      (string c)))))))))
  98.  
  99. ;(define-sharp-macro #\<
  100. ;  (lambda (c port) (read-here-string port)))
  101.